Les Jeux paralympiques sont un événement sportif international majeur, regroupant les sports d’été ou d’hiver, auquel des milliers d’athlètes handicapés participent à travers différentes compétitions tous les quatre ans à la suite des Jeux olympiques, pour chaque olympiade. Y participent des athlètes atteints par un handicap physique, visuel ou mental. Ils sont organisés par le Comité international paralympique (et non pas par le Comité international olympique).

#install.packages("tidyverse")
#install.packages("rvest")
#install.packages("skimr")
#gère différents types de données et renvoie un objet skim_df qui peut être inclus dans un pipeline tidyverse ou affiché de manière élégante pour le lecteur humain.
#install.packages("reshape2")
#Ce package permet surtout le remodelage des données. Ses deux principales fonctions sont la fonction melt, qui permet le passage d’un jeu de données de la mise en forme large à la mise en forme longue, et la fonction cast, qui permet de réaliser l’inverse. 
#install.packages("gganimate")
#Ce package permet d’ajouter des animations aux graphiques statiques produits à l’aide de ggplot2
#install.packages("magick")
#Traitement Facile des Images dans R à l’Aide du Package Magick
#install.packages("maps")
#pour la cartographie 
# Chargement des données et des bibliothèques
library(tidyverse)
library(skimr)
library(knitr)
library(rvest)
library(reshape2)
library(gganimate)
library(magick)
library(maps)
library(kableExtra)
library(knitr) 
SW <- readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/SW.csv')

le jeu des données

SW
## # A tibble: 6,201 x 6
##    gender event               medal  athlete        abb    year
##    <chr>  <chr>               <chr>  <chr>          <chr> <dbl>
##  1 Men    25 m Freestyle 1A   Gold   KENNY Mike     GBR    1980
##  2 Men    25 m Freestyle 1A   Silver KANTOLA Pekka  FIN    1980
##  3 Men    25 m Freestyle 1A   Bronze TIETZE H.      FRG    1980
##  4 Men    25 m Freestyle 1B   Gold   BURGER M.      CAN    1980
##  5 Men    25 m Freestyle 1B   Silver SLUPE G.       USA    1980
##  6 Men    25 m Freestyle 1B   Bronze MAKI Eero      FIN    1980
##  7 Men    25 m Freestyle 1C   Gold   SMYK Zbigniew  POL    1980
##  8 Men    25 m Freestyle 1C   Silver EMMEL Manfred  FRG    1980
##  9 Men    25 m Freestyle 1C   Bronze OCKVIRK Robert USA    1980
## 10 Men    50 m Freestyle CP C Gold   ADLER Kare     NOR    1980
## # ... with 6,191 more rows

Questions:

**1.Quel le classement des pays selon les nombre de medailles depuis le début des jeux ?

compter les medailles de chaque pays

medal_count<- SW %>%
  group_by(abb, medal) %>%
  summarize(Count=length(medal)) 
medal_count
## # A tibble: 172 x 3
## # Groups:   abb [67]
##    abb   medal  Count
##    <chr> <chr>  <int>
##  1 ARG   Bronze     9
##  2 ARG   Gold       5
##  3 ARG   Silver    10
##  4 AUS   Bronze   160
##  5 AUS   Gold     147
##  6 AUS   Silver   158
##  7 AUT   Bronze     2
##  8 AUT   Gold       2
##  9 AUT   Silver     4
## 10 AZE   Gold       1
## # ... with 162 more rows

ordonner les pays par nombre de medailles

ord_med <- medal_count %>%
  group_by(abb) %>%
  summarize(Total=sum(Count)) %>%
  arrange(Total) %>%
  select(abb)
  ord_med
## # A tibble: 67 x 1
##    abb  
##    <chr>
##  1 BAH  
##  2 BUL  
##  3 KAZ  
##  4 LTU  
##  5 MAR  
##  6 TTO  
##  7 VIE  
##  8 IPP  
##  9 SLO  
## 10 TCH  
## # ... with 57 more rows
medal_count$abb <- factor(medal_count$abb, levels=ord_med$abb)

le plot

ggplot(medal_count, aes(x=abb, y=Count, fill=medal)) +
  geom_col() +
  coord_flip() +
  scale_fill_manual(values=c("gold4","gold1","gray70")) +
  ggtitle("Le classement des pays par le total des médailles ") +
  theme(plot.title = element_text(hjust = 0.5))

**2.Quel le Nombre de medailles d’or de la France au fil du temps?

FR_gold <- SW %>% group_by(year, abb, medal) %>% filter(medal=="Gold", abb=='FRA') %>% summarize(Count=n()) %>% arrange(year) %>% group_by(year)
FR_gold 
## # A tibble: 9 x 4
## # Groups:   year [9]
##    year abb   medal Count
##   <dbl> <chr> <chr> <int>
## 1  1980 FRA   Gold      4
## 2  1984 FRA   Gold     35
## 3  1988 FRA   Gold     16
## 4  1992 FRA   Gold     20
## 5  1996 FRA   Gold     12
## 6  2000 FRA   Gold     12
## 7  2004 FRA   Gold      4
## 8  2008 FRA   Gold      2
## 9  2012 FRA   Gold      2

Le plot :

ggplot(FR_gold, aes(x=year, y=Count, group=medal)) +
geom_line(aes(colour=abb)) +
geom_point(aes(colour=abb))+
scale_x_continuous(breaks=FR_gold$year)+
theme(legend.position="none", legend.text=element_text(size=0),axis.text.x=element_text(size=8, angle=90,vjust=0,hjust=1))+
labs(title="le Nombre de medailles d'or de la France au fil du temps", x="années", y="Nombre de Medailles")

**3.quel est le nombre de medailles par sex ?

ggplot(SW,aes(x= gender ,fill= medal))+
  geom_bar()+
  scale_fill_manual(values=c("gold4","gold1","gray70")) +
  ggtitle("nombre de medailles par sex ") +
  theme(plot.title = element_text(hjust = 0.5))

**4.quel est le nombre de medailles par sex pour chaque année ?

ggplot(SW,aes(x= gender ,fill= medal))+
  facet_wrap(~ year)+
  geom_bar()+
  scale_fill_manual(values=c("gold4","gold1","gray70")) +
  ggtitle("nombre de medailles par sex pour chaque année ") +
  theme(plot.title = element_text(hjust = 0.5))  

**5.Quel Le nombre des hommes et des femmes au fil des années?

Tableau de comptage du nombre d’athlètes par année et sexe:

counts_sex <- SW %>%
   filter(gender != "Mixed")%>%
group_by(year,gender) %>%
  summarize(Athletes = length(unique(athlete)))
counts_sex$year <- as.integer(counts_sex$year)
counts_sex
## # A tibble: 20 x 3
## # Groups:   year [10]
##     year gender Athletes
##    <int> <chr>     <int>
##  1  1980 Men         118
##  2  1980 Women        92
##  3  1984 Men         214
##  4  1984 Women       144
##  5  1988 Men         185
##  6  1988 Women        97
##  7  1992 Men         121
##  8  1992 Women       106
##  9  1996 Men         136
## 10  1996 Women       115
## 11  2000 Men         176
## 12  2000 Women       118
## 13  2004 Men         151
## 14  2004 Women       110
## 15  2008 Men         128
## 16  2008 Women        86
## 17  2012 Men         133
## 18  2012 Women        96
## 19  2016 Men         131
## 20  2016 Women       111

Le plot:

ggplot(counts_sex, aes(x=year, y=Athletes, group=gender, color=gender)) +
  geom_point(size=2) +
  geom_line()  +
  scale_color_manual(values=c("darkblue","red")) +
  labs(title = "Le nombre des hommes et des femmes au fil des années") +
  theme(plot.title = element_text(hjust = 0.5))

**6.C’est quoi les 5 catégories les plus populaires par sexe?

Le tableau des catégories les plus populaires par sexe :

popu_event <- SW %>% 
  filter(gender != "Mixed")%>% 
  group_by(event, gender) %>%
  summarize(Count=n()) %>% 
  group_by(gender) %>% 
  top_n(5,event)
popu_event
## # A tibble: 10 x 3
## # Groups:   gender [2]
##    event                     gender Count
##    <chr>                     <chr>  <int>
##  1 50 m Freestyle S5         Women     21
##  2 50 m Freestyle S6         Women     21
##  3 50 m Freestyle S7         Men       21
##  4 50 m Freestyle S7         Women     21
##  5 50 m Freestyle S8         Men       21
##  6 50 m Freestyle S8         Women     21
##  7 50 m Freestyle S9         Men       21
##  8 50 m Freestyle S9         Women     21
##  9 75 m Individual Medley 1A Men        3
## 10 75 m Individual Medley 1B Men        3

Le plot:

ggplot(popu_event, aes(x=event, y=Count, group=gender, label=format(Count, big.mark=".", decimal.mark=","))) +
geom_col(aes(color=gender, fill=gender)) +
geom_text(position=position_stack(vjust=0.5), size=3, check_overlap=TRUE) + 
scale_y_discrete() +
theme(legend.position="right", axis.text.x=element_text(size=10, angle=90,vjust=0,hjust=1))+
labs(title="les 5 catégories les plus  populaires par sexe", x="Catégories", y="Nombre. athletes")

**7.Quels sont les pays qui n’ont pas de médaille d’or mais ils ont les autres ?

data_abb_medal <- dcast(medal_count, abb ~ medal)
data_abb_medal[is.na(data_abb_medal)] <- 0
no_gold_data <- subset(data_abb_medal, Gold == 0 & Silver>0 & Bronze>0)
no_gold_data
##    abb Bronze Gold Silver
## 10 TCH      1    0      1
## 11 KUW      2    0      1
## 20 ZIM      3    0      2
## 25 POR      6    0      3
## 29 SUI      8    0      4
## 35 URS      9    0     11
print("les pays qui n'ont pas de médaille d'or mais ils ont les autres")
## [1] "les pays qui n'ont pas de médaille d'or mais ils ont les autres"
no_gold_data$abb
## [1] TCH KUW ZIM POR SUI URS
## 67 Levels: BAH BUL KAZ LTU MAR TTO VIE IPP SLO TCH KUW LUX CRO CYP HKG ... GBR

**8.

all_medal_sex <- SW%>% group_by(abb, medal, gender) %>%
  summarise(total = n())
head(all_medal_sex)
## # A tibble: 6 x 4
## # Groups:   abb, medal [4]
##   abb   medal  gender total
##   <chr> <chr>  <chr>  <int>
## 1 ARG   Bronze Men        2
## 2 ARG   Bronze Women      7
## 3 ARG   Gold   Women      5
## 4 ARG   Silver Men        3
## 5 ARG   Silver Women      7
## 6 AUS   Bronze Men       63
all_medal_sex.wide <- dcast(all_medal_sex, abb ~ medal+gender)

all_medal_sex.wide[is.na(all_medal_sex.wide)] <- 0
head(all_medal_sex.wide)
##   abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 1 ARG          2            0            7        0          0          5
## 2 AUS         63            0           97       72          0         75
## 3 AUT          2            0            0        2          0          0
## 4 AZE          0            0            0        0          0          1
## 5 BAH          0            0            1        0          0          0
## 6 BEL          7            0            6        4          0          2
##   Silver_Men Silver_Mixed Silver_Women
## 1          3            0            7
## 2         78            0           80
## 3          4            0            0
## 4          3            0            4
## 5          0            0            0
## 6          7            0            5

**8a.Quel sont les pays où juste c’est les hommes qu’y ont gagné la médaille d’or?

no_women_gold <- subset(all_medal_sex.wide, Gold_Women ==0 & Gold_Men>0 )
no_women_gold
##    abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 3  AUT          2            0            0        2          0          0
## 7  BLR          9            0            0       21          0          0
## 12 COL          4            0            0        2          0          0
## 14 CUB          2            0            0        1          0          0
## 18 EGY          6            0            0        1          0          0
## 21 EUN          4            0            2        4          0          0
## 28 GRE         10            0            1       10          0          0
## 29 HKG          2            0            1        1          0          0
## 31 IPP          0            0            0        1          0          0
## 39 KOR          6            0            0        7          0          0
## 42 LUX          0            0            0        1          0          0
## 48 PER          2            0            0        2          0          0
## 56 SVK          2            0            1        2          0          0
## 59 THA          4            0            0        1          0          0
## 66 YUG          8            0            1        3          0          0
##    Silver_Men Silver_Mixed Silver_Women
## 3           4            0            0
## 7          14            0            0
## 12          5            0            0
## 14          2            0            0
## 18          2            0            0
## 21          2            0            1
## 28         15            0            2
## 29          0            0            0
## 31          1            0            0
## 39          2            0            0
## 42          2            0            0
## 48          1            0            0
## 56          0            0            4
## 59          3            0            0
## 66          6            0            0
print(" Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté")
## [1] " Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté"
no_women_gold$abb
##  [1] "AUT" "BLR" "COL" "CUB" "EGY" "EUN" "GRE" "HKG" "IPP" "KOR" "LUX" "PER"
## [13] "SVK" "THA" "YUG"

**8b.Quel sont les pays où les femmes qu’y ont gagné la médaille d’or ?

no_men_gold <- subset(all_medal_sex.wide, Gold_Women>0 & Gold_Men==0 )
no_men_gold 
##    abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 1  ARG          2            0            7        0          0          5
## 4  AZE          0            0            0        0          0          1
## 15 CYP          0            0            1        0          0          2
## 20 EST          1            0            2        0          0          2
## 25 FRO          0            0            5        0          0          1
## 36 JAM          0            0            0        0          0          1
## 38 KAZ          0            0            0        0          0          1
## 53 SGP          0            0            1        0          0          3
##    Silver_Men Silver_Mixed Silver_Women
## 1           3            0            7
## 4           3            0            4
## 15          0            0            1
## 20          0            0            5
## 25          0            0            7
## 36          0            0            3
## 38          0            0            0
## 53          0            0            1
print("Les pays où les hommes n'ont jamis remporté de médaille d'or mais où les femmes l'ont remporté")
## [1] "Les pays où les hommes n'ont jamis remporté de médaille d'or mais où les femmes l'ont remporté"
no_men_gold$abb
## [1] "ARG" "AZE" "CYP" "EST" "FRO" "JAM" "KAZ" "SGP"
**9.quelle la distrubtion des medailles dans le monde en 1980 et 2016?
noc <- readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/noc_regions.csv')

noc = noc %>%
  rename(abb = NOC)
noc
## # A tibble: 230 x 3
##    abb   region      notes               
##    <chr> <chr>       <chr>               
##  1 AFG   Afghanistan <NA>                
##  2 AHO   Curacao     Netherlands Antilles
##  3 ALB   Albania     <NA>                
##  4 ALG   Algeria     <NA>                
##  5 AND   Andorra     <NA>                
##  6 ANG   Angola      <NA>                
##  7 ANT   Antigua     Antigua and Barbuda 
##  8 ANZ   Australia   Australasia         
##  9 ARG   Argentina   <NA>                
## 10 ARM   Armenia     <NA>                
## # ... with 220 more rows

Ajouter les noms complets des pays à notre base

data_regions <- SW %>% 
  left_join(noc,by="abb") %>%
  filter(!is.na(region))

sous ensemble pour les jeux de 1980 et 2016,compter les athletes de chaque pays.

rio <- data_regions %>% 
  filter(year == "2016") %>%
  group_by(region) %>%
  summarize(Rio = length(unique(athlete)))

Arnhem_et_Veenendaal<- data_regions %>% 
  filter(year == "1980") %>%
  group_by(region) %>%
  summarize(Arnhem = length(unique(athlete)))

Creation des données pour la catographie

world <- map_data("world")
mapdat <- tibble(region=unique(world$region))
mapdat <- mapdat %>% 
  left_join(Arnhem_et_Veenendaal, by="region") %>%
  left_join(rio, by="region")
mapdat$Arnhem[is.na(mapdat$Arnhem)] <- 0
mapdat$Rio[is.na(mapdat$Rio)] <- 0
world <- left_join(world, mapdat, by="region")

la catographie: Arnhem et Veenendaal 1980

ggplot(world, aes(x = long, y = lat, group = group)) +
  geom_polygon(aes(fill = Arnhem)) +
  labs(title = "Arnhem et Veenendaal  1980",
       x = NULL, y = NULL) +
  theme(axis.ticks = element_blank(),
        axis.text = element_blank(),
        panel.background = element_rect(fill = "navy"),
        plot.title = element_text(hjust = 0.5)) +
  guides(fill=guide_colourbar(title="Athletes")) +
  scale_fill_gradient2(low="white",high = "red")

la catographie: Rio 2016

ggplot(world, aes(x = long, y = lat, group = group)) +
  geom_polygon(aes(fill = Rio)) +
  labs(title = "Rio 2016",
       x = NULL, y = NULL) +
  theme(axis.ticks = element_blank(),
        axis.text = element_blank(),
        panel.background = element_rect(fill = "navy"),
        plot.title = element_text(hjust = 0.5)) +
  guides(fill=guide_colourbar(title="Athletes")) +
  scale_fill_gradient2(low="white",high = "red")

La décomposition en continent :

Rajouter une colonne continent:

continent <-readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/data.csv')
continent = continent %>%
  rename(abb = Three_Letter_Country_Code)

medal_continent <- SW %>%
left_join(continent,by="abb") %>%
  filter(!is.na(Continent_Name))

**10.Combien chaque continent à de médailles ?

Le nombre de medailles en détail de chaque continent par année :

medal_continent<- medal_continent %>% 
  group_by(year,Continent_Name) %>%
  summarize(Count=length(medal)) 
medal_continent
## # A tibble: 55 x 3
## # Groups:   year [10]
##     year Continent_Name Count
##    <dbl> <chr>          <int>
##  1  1980 Africa             1
##  2  1980 Asia              25
##  3  1980 Europe           238
##  4  1980 North America    119
##  5  1980 Oceania           13
##  6  1980 South America     13
##  7  1984 Africa             1
##  8  1984 Asia              38
##  9  1984 Europe           455
## 10  1984 North America    212
## # ... with 45 more rows

Le total des medailles de chaque continent :

sum_medal_cont <- medal_continent %>%
  group_by(Continent_Name) %>%
  summarize(nombre_de_medailles=sum(Count))
 sum_medal_cont 
## # A tibble: 6 x 2
##   Continent_Name nombre_de_medailles
##   <chr>                        <int>
## 1 Africa                          10
## 2 Asia                           765
## 3 Europe                        2759
## 4 North America                 1088
## 5 Oceania                        528
## 6 South America                  178

Le pourcentage de chaque continent dans le total des médailles :

pie_chart<- sum_medal_cont %>% 
  mutate(perc = `nombre_de_medailles` / sum(`nombre_de_medailles`)) %>% 
  arrange(perc) %>%
  mutate(labels = scales::percent(perc))
pie_chart
## # A tibble: 6 x 4
##   Continent_Name nombre_de_medailles    perc labels
##   <chr>                        <int>   <dbl> <chr> 
## 1 Africa                          10 0.00188 0.2%  
## 2 South America                  178 0.0334  3.3%  
## 3 Oceania                        528 0.0991  9.9%  
## 4 Asia                           765 0.144   14.4% 
## 5 North America                 1088 0.204   20.4% 
## 6 Europe                        2759 0.518   51.8%

Le camembert :

ggplot(pie_chart, aes(x = "", y = perc, fill = Continent_Name)) +
  geom_col() +
  coord_polar(theta = "y")

**10.quelle l’evolution des nombres de medailles par continent au fil des années ?

Nous voulons ici que le nombre de médailles change en fonction des années et des continent. Nous utiliserons alors un diagramme à barres:

plot_anime1 <- ggplot(data = medal_continent) +
  geom_col(mapping = aes(x = Continent_Name, y = Count), 
           fill = "darkcyan") +
  theme_classic() +
  xlab("Continent") +
  ylab("Nombre de médailles ") +
  transition_states(year,
                    transition_length = 2,
                    state_length = 1, 
                    wrap = TRUE) +
  ggtitle("Année : {closest_state}")
plot_anime1

Les diagrammes à barres peuvent être intéressants pour comparer les données d’une seule année à la fois entre elles, mais ne permettent pas de comparer la progression du nombre de medailles par année sur un seul plan de vue. Nous pourrions alors créer un graphique à lignes avec geom_line.

plot_anime2 <- ggplot(data = medal_continent, aes(x = year, y = Count, group=Continent_Name, color=Continent_Name)) +
  geom_line() +
  geom_point() +
  ggtitle("Nombre de médailles entre 1980 et 2016") +
  ylab("Nombre de médailles") +
  xlab("Année")+
  theme_classic()+
  view_follow(fixed_x = TRUE, 
              fixed_y = TRUE) +
  transition_reveal(year)
plot_anime2 <- animate(plot_anime2, end_pause = 15)
plot_anime2

Section par Paolo Crosetto

Questions additionnelles

1. Couleur des médailles

Pourriez-vous corriger le bug et assigner le bon couleur aux médailles?

Réponse:

Pour le bug j’ai testé avec des amis et normalement ça marche . Voici les graphiques des questions 1,3,4 àpres la correction des couleurs : Question 1

ggplot(medal_count, aes(x=abb, y=Count, fill=medal)) +
  geom_col() +
  coord_flip() +
  scale_fill_manual(values=c("gold4","gold1","gray70")) +
  ggtitle("Le classement des pays par le total des médailles ") +
  theme(plot.title = element_text(hjust = 0.5))

Question 3:

ggplot(SW,aes(x= gender ,fill= medal))+
  geom_bar()+
  scale_fill_manual(values=c("gold4","gold1","gray70")) +
  ggtitle("nombre de medailles par sex ") +
  theme(plot.title = element_text(hjust = 0.5))

Question 4:

ggplot(SW,aes(x= gender ,fill= medal))+
  facet_wrap(~ year)+
  geom_bar()+
  scale_fill_manual(values=c("gold4","gold1","gray70")) +
  ggtitle("nombre de medailles par sex pour chaque année ") +
  theme(plot.title = element_text(hjust = 0.5))  

2. dcast()

Vous avez utilisé la fonction dcast. Quel est son rôle? Qu’est-ce qu’elle fait? Pourriez-vous faire la même action avec une ou plusieurs fonctions qu’on a vu en cours?

Réponse:

Quel est son rôle? Qu’est-ce qu’elle fait?

La fonction dcast est une fonction proposée par le package {reshape2}. Elle prend une série de lignes pour mettre leur contenu sous forme de plusieurs colonnes.Des lignes pivot restant orientées à l’indentique-leur contenu est juste recopié doivent etre proposées.l’idée est de passer d’une table “haute”(avec de nombreuses lignes mais peu de colonnes) à une table “large” (avec de nombreuses colonnes).La fonction qui réalise l’inverse de dcast est la fonction melt l’opération inverse : d’une table large on passe à une table haute . Il faut donc faire attention à ce que ces variables aient un nombre limité de valeurs, pour ne pas obtenir une table extrêmement large.

quel est la fonction vu dans le cours qui fait le meme chose que dcast?

La fonction pivot_wider() du package {tidyr} permet d’élargir ses données en augmentant le nombre de colonnes et en diminuant le nombre de lignes elle propose la meme action que dcast et la fonction qui fait son inverse est pivot_longer() .

pivot_wider prend deux arguments principaux : names_from: indique la colonne contenant les noms des nouvelles variables à créer values_from indique: la colonne contenant les valeurs de ces variables. Il peut arriver que certaines variables soient absentes pour certaines observations. Dans ce cas l’argument values_fill permet de spécifier la valeur à utiliser pour ces données manquantes .

Rprenons les questions déja faites avec la fonction “pivot_wider”

Question 7:

pivo <- medal_count %>% 
  select(medal,Count) %>% 
  pivot_wider(names_from = medal, values_from = Count ,values_fill = 0) 
  head(pivo) %>%
      kbl() %>%
      kable_styling()
abb Bronze Gold Silver
ARG 9 5 10
AUS 160 147 158
AUT 2 2 4
AZE 0 1 7
BAH 1 0 0
BEL 13 6 12
no_gold_data <- subset(pivo, Gold == 0 & Silver>0 & Bronze>0)
 no_gold_data %>%
      kbl() %>%
      kable_styling()
abb Bronze Gold Silver
KUW 2 0 1
POR 6 0 3
SUI 8 0 4
TCH 1 0 1
URS 9 0 11
ZIM 3 0 2
print("les pays qui n'ont pas de médaille d'or mais ils ont les autres")
## [1] "les pays qui n'ont pas de médaille d'or mais ils ont les autres"
no_gold_data$abb
## [1] KUW POR SUI TCH URS ZIM
## 67 Levels: BAH BUL KAZ LTU MAR TTO VIE IPP SLO TCH KUW LUX CRO CYP HKG ... GBR

Question 8:

all_medal_sex <- SW%>% group_by(abb, medal, gender) %>%
  summarise(total = n())
head(all_medal_sex) %>%
      kbl() %>%
      kable_styling()
abb medal gender total
ARG Bronze Men 2
ARG Bronze Women 7
ARG Gold Women 5
ARG Silver Men 3
ARG Silver Women 7
AUS Bronze Men 63
pivo2 <- all_medal_sex %>% 
  pivot_wider(names_from = c(medal,gender), values_from =total,values_fill = 0) %>%
  group_by(abb)
head(pivo2) %>%
        kbl() %>%
        kable_styling()
abb Bronze_Men Bronze_Women Gold_Women Silver_Men Silver_Women Gold_Men Silver_Mixed Gold_Mixed Bronze_Mixed
ARG 2 7 5 3 7 0 0 0 0
AUS 63 97 75 78 80 72 0 0 0
AUT 2 0 0 4 0 2 0 0 0
AZE 0 0 1 3 4 0 0 0 0
BAH 0 1 0 0 0 0 0 0 0
BEL 7 6 2 7 5 4 0 0 0
no_women_gold <- subset(pivo2, Gold_Women ==0 & Gold_Men>0 )
no_women_gold %>%
      kbl() %>%
      kable_styling()
abb Bronze_Men Bronze_Women Gold_Women Silver_Men Silver_Women Gold_Men Silver_Mixed Gold_Mixed Bronze_Mixed
AUT 2 0 0 4 0 2 0 0 0
BLR 9 0 0 14 0 21 0 0 0
COL 4 0 0 5 0 2 0 0 0
CUB 2 0 0 2 0 1 0 0 0
EGY 6 0 0 2 0 1 0 0 0
EUN 4 2 0 2 1 4 0 0 0
GRE 10 1 0 15 2 10 0 0 0
HKG 2 1 0 0 0 1 0 0 0
IPP 0 0 0 1 0 1 0 0 0
KOR 6 0 0 2 0 7 0 0 0
LUX 0 0 0 2 0 1 0 0 0
PER 2 0 0 1 0 2 0 0 0
SVK 2 1 0 0 4 2 0 0 0
THA 4 0 0 3 0 1 0 0 0
YUG 8 1 0 6 0 3 0 0 0
print(" Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté")
## [1] " Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté"
no_women_gold$abb
##  [1] "AUT" "BLR" "COL" "CUB" "EGY" "EUN" "GRE" "HKG" "IPP" "KOR" "LUX" "PER"
## [13] "SVK" "THA" "YUG"

3. gganimate

Vous vez utilisé gganimate. Très bien! Pourriez-vous aussi produire un plot qui montre (et anime) la somme cumulative des médailles d’or au fil du temps pour la France, l’Italie, la Grande Bretagne et l’Allemagne?

Le nombre de medailles en détail de chaque pays par année :

#on mets les pays dans un pays pour pouvoir après les filtrer  
target <- c("FRA","ITA","GBR","GER")

#la somme cumulative des médailles d'or  au fil du temps 
medail_cum<-SW %>%
select(abb, medal,year) %>% 
  filter(medal == "Gold") %>%
  group_by(abb,year) %>% 
  summarise(Nb_m=n()) %>%
  mutate(med_cum = cumsum(Nb_m)) %>%
  filter(abb %in% target) 
      medail_cum %>%
      kbl() %>%
      kable_styling()
abb year Nb_m med_cum
FRA 1980 4 4
FRA 1984 35 39
FRA 1988 16 55
FRA 1992 20 75
FRA 1996 12 87
FRA 2000 12 99
FRA 2004 4 103
FRA 2008 2 105
FRA 2012 2 107
GBR 1980 18 18
GBR 1984 26 44
GBR 1988 36 80
GBR 1992 22 102
GBR 1996 19 121
GBR 2000 20 141
GBR 2004 23 164
GBR 2008 14 178
GBR 2012 7 185
GBR 2016 19 204
GER 1992 26 26
GER 1996 31 57
GER 2000 2 59
GER 2004 5 64
GER 2008 1 65
GER 2012 2 67
ITA 1984 3 3
ITA 1988 5 8
ITA 1992 2 10
ITA 1996 2 12
ITA 2004 1 13
ITA 2008 1 14
ITA 2012 2 16
ITA 2016 2 18

Pour comparer la progression de la somme de medailles par année sur un seul plan de vue. Nous pourrions alors créer un graphique à lignes avec geom_line :

plot_cum <- ggplot(data = medail_cum, aes(x = year, y = med_cum, group=abb, color=abb)) +
  geom_line() +
  geom_point() +
  ggtitle("La somme cumulative des médailles d'or au fil du temps") +
  ylab("Nombre de médailles") +
  xlab("Année")+
  theme_classic()+
  view_follow(fixed_x = TRUE, 
              fixed_y = TRUE) +
  transition_reveal(year)
plot1 <- animate(plot_cum , end_pause = 10)
plot1 

Nous voulons ici que la somme cumulative de médailles d’or change en fonction des années et des pays. Nous utiliserons alors un diagramme à barres:

#Pour créer notre animation de graphique à barres, nous analyserons l'évolution des pays avec leur nombre de medailles d'or sur l'ensemble de données de medail_cum. Pour ce faire, nous devons d'abord obtenir le classement des pays chaque année. C'est quelque chose que nous pouvons facilement faire avec dplyr :
medail_cum1 <- medail_cum %>%
  group_by(year) %>%
  arrange(year, desc(med_cum)) %>%
  mutate(ranking = row_number()) 
  
  medail_cum1 %>%
      kbl() %>%
      kable_styling()
abb year Nb_m med_cum ranking
GBR 1980 18 18 1
FRA 1980 4 4 2
GBR 1984 26 44 1
FRA 1984 35 39 2
ITA 1984 3 3 3
GBR 1988 36 80 1
FRA 1988 16 55 2
ITA 1988 5 8 3
GBR 1992 22 102 1
FRA 1992 20 75 2
GER 1992 26 26 3
ITA 1992 2 10 4
GBR 1996 19 121 1
FRA 1996 12 87 2
GER 1996 31 57 3
ITA 1996 2 12 4
GBR 2000 20 141 1
FRA 2000 12 99 2
GER 2000 2 59 3
GBR 2004 23 164 1
FRA 2004 4 103 2
GER 2004 5 64 3
ITA 2004 1 13 4
GBR 2008 14 178 1
FRA 2008 2 105 2
GER 2008 1 65 3
ITA 2008 1 14 4
GBR 2012 7 185 1
FRA 2012 2 107 2
GER 2012 2 67 3
ITA 2012 2 16 4
GBR 2016 19 204 1
ITA 2016 2 18 2

Voici la deuxième animation :

plot_cum2 <- medail_cum1 %>%
  ggplot() +
  geom_col(aes(ranking, med_cum, fill = abb)) +
  geom_text(aes(ranking, med_cum, label = med_cum), hjust=-0.1) +
  geom_text(aes(ranking, y=0 , label = abb), hjust=1.1) + 
  geom_text(aes(x=4, y=max(med_cum) , label = as.factor(year)), vjust = 0.2, alpha = 0.5,  col = "gray", size = 20) +
  ggtitle("la somme cumulative des médailles d'or au fil du temps") +
  coord_flip(clip = "off", expand = FALSE) + scale_x_reverse() +
  theme_minimal() + theme(
    panel.grid = element_blank(), 
    legend.position = "none",
    axis.ticks.y = element_blank(),
    axis.title.y = element_blank(),
    axis.text.y = element_blank(),
    plot.margin = margin(1, 4, 1, 3, "cm")
  ) +
  transition_states(year, state_length = 0, transition_length = 2) +
  enter_fade() +
  exit_fade() + 
  ease_aes('quadratic-in-out') 

plot2 <- animate(plot_cum2,width = 700, height = 432, fps = 25, duration = 15, rewind = FALSE)
plot2